﻿Imports Microsoft.VisualBasic
Imports System.Data
Imports System.Web
Imports System.Text


''' <summary>
''' VB通用类库
''' </summary>
''' <remarks></remarks>
Public Module VBFunctions

#Region "属性结构"
    Dim zyuSQL As New SQLDBClass


    Sub New()

    End Sub

#End Region

#Region "Session处理"

#End Region

#Region "生成验证码图片"
    ''' <summary>
    ''' 生成验证码值
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function CreateCode() As String
        Dim cTime As Date = Date.Now
        Dim mm As Integer = cTime.Minute
        Dim ss As Integer = cTime.Second
        Dim rnd As New Random
        Dim rndNum As Double = rnd.NextDouble()
        Randomize()
        Dim codeNum As Integer = CInt(rndNum * 9899 + 101)
        Return FillNumber(CStr(codeNum), 4)
    End Function

    ''' <summary>
    ''' 加密验证码
    ''' </summary>
    ''' <param name="CodeN">原验证码</param>
    ''' <param name="dNum">加密数值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetCodeF(ByVal CodeN As String, ByVal dNum As Integer) As String
        Dim cCode As Integer = CInt(CodeN)
        Dim nCode As Integer = cCode - dNum
        If nCode < 0 Then nCode += 10
        Return nCode.ToString
    End Function

    ''' <summary>
    ''' 生成验证码图片
    ''' </summary>
    ''' <param name="sCode">验证码</param>
    ''' <param name="sWidth">宽度</param>
    ''' <param name="sHeight">高度</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function CreateImage(ByVal sCode As String, Optional ByVal sWidth As Integer = 60, Optional ByVal sHeight As Integer = 22, Optional savPath As String = "imgCode") As String
        Dim sImg As Drawing.Image = Nothing
        Dim ScodeStrs(3) As String
        Dim codeF(3) As String
        Dim dColorI As Integer = 0
        Dim imgURL As String = "" '"imgCode/" & sCode & ".jpg"
        Dim bmp As New Drawing.Bitmap(sWidth, sHeight)
        Dim grp As Drawing.Graphics = Drawing.Graphics.FromImage(bmp)
        Dim dFont As New Drawing.Font("Arial", 18, Drawing.FontStyle.Bold, Drawing.GraphicsUnit.Pixel)  '字体样式
        Dim dBrushN(9) As Drawing.SolidBrush

        Try
            ScodeStrs(0) = sCode.Substring(0, 1)
            ScodeStrs(1) = sCode.Substring(1, 1)
            ScodeStrs(2) = sCode.Substring(2, 1)
            ScodeStrs(3) = sCode.Substring(3, 1)
            codeF(0) = GetCodeF(ScodeStrs(0), 1)
            codeF(1) = GetCodeF(ScodeStrs(1), 4)
            codeF(2) = GetCodeF(ScodeStrs(2), 3)
            codeF(3) = GetCodeF(ScodeStrs(3), 2)
            imgURL = savPath & "/" & codeF(0) & codeF(1) & codeF(2) & codeF(3) & ".jpg"
            Dim actPath As String = System.Web.HttpContext.Current.Server.MapPath(imgURL)
            dColorI = CInt(codeF(3))

            '颜色样式
            dBrushN(0) = New Drawing.SolidBrush(Drawing.Color.Blue)
            dBrushN(1) = New Drawing.SolidBrush(Drawing.Color.Red)
            dBrushN(2) = New Drawing.SolidBrush(Drawing.Color.Green)
            dBrushN(3) = New Drawing.SolidBrush(Drawing.Color.DarkOrange)
            dBrushN(4) = New Drawing.SolidBrush(Drawing.Color.Pink)
            dBrushN(5) = New Drawing.SolidBrush(Drawing.Color.Purple)
            dBrushN(6) = New Drawing.SolidBrush(Drawing.Color.DeepSkyBlue)
            dBrushN(7) = New Drawing.SolidBrush(Drawing.Color.Brown)
            dBrushN(8) = New Drawing.SolidBrush(Drawing.Color.BlueViolet)
            dBrushN(9) = New Drawing.SolidBrush(Drawing.Color.Gold)

            grp.Clear(Drawing.Color.DarkGray)
            grp.DrawString(ScodeStrs(0), dFont, dBrushN(CInt(GetCodeF(ScodeStrs(0), dColorI))), 1, 1)
            grp.DrawString(ScodeStrs(1), dFont, dBrushN(CInt(GetCodeF(ScodeStrs(1), dColorI + 2))), 11, 1)
            grp.DrawString(ScodeStrs(2), dFont, dBrushN(CInt(GetCodeF(ScodeStrs(2), dColorI - 1))), 21, 1)
            grp.DrawString(ScodeStrs(3), dFont, dBrushN(CInt(GetCodeF(ScodeStrs(3), dColorI + 1))), 32, 1)
            sImg = System.Drawing.Image.FromHbitmap(bmp.GetHbitmap)
            sImg.Save(actPath, Drawing.Imaging.ImageFormat.Jpeg)
            Return imgURL
        Catch ex As Exception
            Return imgURL
        End Try
    End Function

    ''' <summary>
    ''' 获取验证码值
    ''' </summary>
    ''' <param name="imgFold">保存验证码的目录</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetCodeValue(Optional imgFold As String = "imgCode") As String
        DelAllFiles(imgFold)
        Dim Codes As String = CreateCode()
        Return Codes
    End Function


#End Region


#Region "文件(夹)处理"
    ''' <summary>
    ''' 删除文件夹下所有文件
    ''' </summary>
    ''' <param name="foldName">要删除文件的文件夹名</param>
    ''' <remarks></remarks>
    Sub DelAllFiles(ByVal foldName As String)
        Try
            If foldName.Trim = "" Then Exit Sub
            Dim actPath As String = System.Web.HttpContext.Current.Server.MapPath(foldName)
            For Each filName As String In IO.Directory.GetFiles(actPath)
                IO.File.Delete(filName)
            Next
        Catch ex As Exception

        End Try
    End Sub

    ''' <summary>
    ''' 显示文件大小(自动转换单位)
    ''' </summary>
    ''' <param name="fSize"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetFileSize(ByVal fSize As Long) As String
        Dim strSize As String = ""
        Select Case fSize
            Case Is < 1024
                strSize = fSize & " Bit"
            Case 1024 To 1048576
                strSize = Math.Round(fSize / 1024, 1) & " KB "
            Case 1048576 To 1073741824
                strSize = Math.Round(fSize / 1048576, 1) & " MB "
            Case Else
                strSize = Math.Round(fSize / 1073741824, 1) & " GB "
        End Select
        Return strSize
    End Function

    ''' <summary>
    ''' 获取文件图标
    ''' </summary>
    ''' <param name="fileName">文件名</param>
    ''' <param name="iconWidth">图标大小（默认35）</param>
    ''' <param name="iconType">图标模式 0:返回整个图标IMG  1:返回图标地址SRC</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getFileIcon(Optional fileName As String = "", Optional iconWidth As Integer = 35, Optional iconType As Integer = 0) As String
        Dim strIcon As String = "" '/webprogram/FileIcon/uno.jpg
        Dim extName As String = getExtName(fileName)
        Dim iconB As New StringBuilder
        strIcon = "/webprogram/FileIcon/" & extName & ".jpg"
        Dim fiName As String = System.Web.HttpContext.Current.Server.MapPath(strIcon)
        If Not IO.File.Exists(fiName) Then
            Select Case extName
                Case "html"
                    extName = "htm"
                Case "jsp", "php", "aspx", "ascx", "ashx", "js"
                    extName = "asp"
                Case "docx"
                    extName = "doc"
                Case "xlsx"
                    extName = "xls"
                Case "zip", "jar", "7-zip", "cab", "iso"
                    extName = "rar"
                Case "ini", "inf"
                    extName = "txt"
                Case Else
                    extName = "uno"
            End Select
        Else

        End If

        strIcon = "/webprogram/FileIcon/" & extName & ".jpg"
        fiName = System.Web.HttpContext.Current.Server.MapPath(strIcon)
        If Not IO.File.Exists(fiName) Then
            strIcon = "/webprogram/FileIcon/uno.jpg"
        End If
        If iconType = 0 Then
            iconB.AppendFormat("<img src=""{0}"" width=""{1}"" />", strIcon, iconWidth)
            Return iconB.ToString
        Else
            Return strIcon
        End If
    End Function

    ''' <summary>
    ''' 获取文件扩展名
    ''' </summary>
    ''' <param name="fileName">文件名</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getExtName(fileName As String) As String
        If fileName.Trim = "" Then Return "uno"
        Dim ei As Integer = fileName.LastIndexOf(".")
        Dim ln As Integer = fileName.Length
        Dim extN As String = fileName.Substring(ei + 1, ln - ei - 1)
        Return extN.ToLower
    End Function

    ''' <summary>
    ''' 获取短文件名
    ''' </summary>
    ''' <param name="fileName">文件名</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getShortName(fileName As String) As String
        If fileName.Trim = "" Then Return ""
        fileName = fileName.Replace("\", "/")
        Dim ei As Integer = fileName.LastIndexOf("/")
        Dim ln As Integer = fileName.Length
        Dim sortN As String = fileName.Substring(ei + 1, ln - ei - 1)
        Return sortN
    End Function
#End Region


#Region "字符处理"

    ''' <summary>
    ''' 获取默认字符，如果为空则取默认值
    ''' </summary>
    ''' <param name="sObject">获取的对象</param>
    ''' <param name="defaultv">默认值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function dValue(sObject As Object, defaultv As String) As String
        Try
            If sObject Is Nothing Then Return defaultv
            If CStr(sObject) = "" Then Return defaultv
            Return CStr(sObject)
        Catch ex As Exception
            Return defaultv
        End Try
    End Function

    ''' <summary>
    ''' 获取默认整型数字，如果为空则取默认值
    ''' </summary>
    ''' <param name="sObject">获取的对象</param>
    ''' <param name="defaultv">默认值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function dValue(sObject As Object, defaultv As Integer) As Integer
        Try
            If sObject Is Nothing Then Return defaultv
            Return CInt(sObject)
        Catch ex As Exception
            Return defaultv
        End Try
    End Function

    ''' <summary>
    ''' 获取默认浮点数字，如果为空则取默认值
    ''' </summary>
    ''' <param name="sObject">获取的对象</param>
    ''' <param name="defaultv">默认值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function dValue(sObject As Object, defaultv As Double) As Double
        Try
            If sObject Is Nothing Then Return defaultv
            Return CDbl(sObject)
        Catch ex As Exception
            Return defaultv
        End Try
    End Function

    ''' <summary>
    ''' 获取默认布尔值，如果为空则取默认值
    ''' </summary>
    ''' <param name="sObject">获取的对象</param>
    ''' <param name="defaultv">默认值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function dValue(sObject As Object, defaultv As Boolean) As Boolean
        Try
            If sObject Is Nothing Then Return defaultv
            Return CBool(sObject)
        Catch ex As Exception
            Return defaultv
        End Try
    End Function



    ''' <summary>
    ''' 创建相同数量的字符
    ''' </summary>
    ''' <param name="sStr">要显示的字符</param>
    ''' <param name="num">重复数量</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function StringNum(ByVal sStr As String, ByVal num As Integer) As String
        Dim nsStr As String = ""
        For i As Integer = 1 To num
            nsStr &= sStr
        Next
        Return nsStr
    End Function

    ''' <summary>
    ''' 字符转为十六进制
    ''' </summary>
    ''' <param name="gbString">普通十进制字符</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function StringToHex(ByVal gbString As String) As String 'sGB为传来的汉字字符串
        Try
            Dim sResult As String, nResult As String = ""
            Dim iLoop As Integer
            Dim sHex As String = ""
            Dim sAsc As Integer
            Dim di As Integer = 0
            Dim bLen As Integer = Len(gbString)

            sResult = ""
            For iLoop = 1 To bLen
                sAsc = Asc(Mid(gbString, iLoop, 1))
                sHex = Hex(sAsc)
                If sHex.Length > 4 Then
                    sHex = sHex.Substring(sHex.Length - 4, 4)
                End If
                If sAsc < 0 Then
                    sHex = FillNumber(sHex, 4)
                Else
                    sHex = FillNumber(sHex, 2)
                End If
                sResult = sResult & sHex
            Next iLoop
            Return sResult
        Catch ex As Exception
            Return ""
        End Try
    End Function

    ''' <summary>
    ''' 十六进制转字符（支持汉字）
    ''' </summary>
    ''' <param name="hexString">十六进制符</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function HexToString(ByVal hexString As String) As String
        Try
            If hexString.Trim = "" Then
                'MsgBox("字符串无效：不能为空！", MsgBoxStyle.Information, "出错了")
                Return "Err:字符串无效：不能为空！"
            End If
            hexString = hexString.Trim
            hexString = hexString.Replace(Chr(32), "")
            hexString = hexString.Replace(vbCrLf, "")
            hexString = hexString.Replace(vbCr, "")
            hexString = hexString.Replace(vbLf, "")

            If hexString.Length Mod 2 <> 0 Then
                'MsgBox("字符串无效：长度不能为奇数！", MsgBoxStyle.Information, "出错了")
                Return "Err:字符串无效：长度不能为奇数！"
            End If
            Dim bLen As Integer = hexString.Length

            Dim bytes As Byte() = New Byte(CInt(hexString.Length / 2 - 1)) {}
            For i As Integer = 0 To bytes.Length - 1
                Try
                    bytes(i) = Byte.Parse(hexString.Substring(i * 2, 2), System.Globalization.NumberStyles.HexNumber)

                Catch ex As Exception
                    'MsgBox("输入字符串无效！" & vbCrLf & ex.Message, MsgBoxStyle.Information, "出错了")
                End Try
            Next
            Dim EncordingCHS As System.Text.Encoding = System.Text.Encoding.GetEncoding("GB2312")
            Return EncordingCHS.GetString(bytes)
        Catch ex As Exception
            Return ""
        End Try

    End Function

    ''' <summary>
    ''' 定长字符不足时前面填充0
    ''' </summary>
    ''' <param name="Value">要填充的源字符</param>
    ''' <param name="len">字符总长度</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function FillNumber(ByVal Value As String, ByVal len As Integer) As String
        Dim l As Integer = Value.Length
        Dim filStr As String = ""
        If l < len Then
            For li As Integer = 1 To len - l
                filStr &= "0"
            Next
        End If
        Return filStr & Value
    End Function

    ''' <summary>
    ''' 转译URL
    ''' </summary>
    ''' <param name="urlString">原始URL</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function urlEncording(ByVal urlString As String) As String
        If urlString.Trim = "" Then Return ""
        Return HttpUtility.UrlEncode(urlString, System.Text.Encoding.UTF8)
    End Function

    ''' <summary>
    ''' 删除末尾匹配的字符
    ''' </summary>
    ''' <param name="sText">原字符串</param>
    ''' <param name="delChar">要匹配去掉的字符</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function DelEndChar(ByVal sText As String, ByVal delChar As String) As String
        Try
            Dim reText As String = sText
            If sText.EndsWith(delChar) Then
                reText = sText.Substring(0, sText.Length - 1)
            End If
            Return reText
        Catch ex As Exception
            Return ""
        End Try
    End Function

    ''' <summary>
    ''' 删除开头匹配的字符
    ''' </summary>
    ''' <param name="sText">原字符串</param>
    ''' <param name="delChar">要匹配去掉的字符</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function DelStartChar(ByVal sText As String, ByVal delChar As String) As String
        Try
            Dim reText As String = sText
            If sText.StartsWith(delChar) Then
                reText = sText.Substring(1, sText.Length - 1)
            End If
            Return reText
        Catch ex As Exception
            Return ""
        End Try
    End Function

    ''' <summary>
    ''' 删除前后匹配的字符
    ''' </summary>
    ''' <param name="sText">原字符串</param>
    ''' <param name="delChar">要匹配去掉的字符</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function DelStartEndChart(ByVal sText As String, ByVal delChar As String) As String
        Dim reText As String = ""
        reText = DelStartChar(sText, delChar)
        reText = DelEndChar(reText, delChar)
        Return reText
    End Function


#End Region


#Region "日期时间处理"
    ''' <summary>
    ''' 固定长日期格式
    ''' </summary>
    ''' <param name="sDate">日期数</param>
    ''' <param name="sShar">连接符</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function showLongDate(ByVal sDate As Date, Optional ByVal sShar As String = "-") As String
        If sDate = Nothing Then Return ""
        Dim sYY, sMM, sDD As Integer
        Dim nDate As String
        sYY = sDate.Year
        sMM = sDate.Month
        sDD = sDate.Day
        nDate = sYY & sShar & FillNumber(CStr(sMM), 2) & sShar & FillNumber(CStr(sDD), 2)
        Return nDate
    End Function

    ''' <summary>
    ''' 获取某月最后一天
    ''' </summary>
    ''' <param name="YearMonth">要获取的月份</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getLastday(YearMonth As String) As Integer
        If YearMonth.Length < 5 Then Return 0
        Dim cYY As Integer = YearMonth.Substring(0, 4)
        Dim cMM As Integer = YearMonth.Substring(4)
        Dim lsmDay As String = ""
        For d As Integer = 31 To 28 Step -1
            lsmDay = cYY & "-" & cMM & "-" & d
            If IsDate(lsmDay) Then
                Return d
            End If
        Next
        Return 28
    End Function

    ''' <summary>
    ''' 获取某月最后一天
    ''' </summary>
    ''' <param name="sDate">获取月所在的日期</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getLastday(sDate As Date) As Integer
        Dim cYY As Integer = Year(sDate)
        Dim cMM As Integer = Month(sDate)
        Dim lsmDay As String = ""
        For d As Integer = 31 To 28 Step -1
            lsmDay = cYY & "-" & cMM & "-" & d
            If IsDate(lsmDay) Then
                Return d
            End If
        Next
        Return 28
    End Function
#End Region


#Region "JS处理"

    ''' <summary>
    '''
    ''' </summary>
    ''' <param name="sPage">页面对象(一般为本页Me)</param>
    ''' <param name="JSFunction">JS函数</param>
    ''' <remarks></remarks>
    Sub ExecuteJS(ByVal sPage As UI.Page, ByVal JSFunction As String)
        sPage.RegisterStartupScript("execJS", "<script>" & JSFunction & "</script>")
    End Sub


    ''' <summary>
    ''' 弹出客户端对话框(alert)
    ''' </summary>
    ''' <param name="sPage">页面对象(一般为本页Me)</param>
    ''' <param name="Message">要弹出的信息</param>
    ''' <remarks></remarks>
    Sub ExecuteJSalert(ByVal sPage As UI.Page, Optional ByVal Message As String = "")
        sPage.RegisterStartupScript("execJSAlert", "<script>alert('" & Message & "');</script>")
    End Sub

#End Region

#Region "加密处理"

    ''' <summary>
    ''' 进制转换
    ''' </summary>
    ''' <param name="value">要转换的字符</param>
    ''' <param name="fromBase">源进制(如:2,8,10,16)</param>
    ''' <param name="toBase">目标进制(如:2,8,10,16)</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function ConvertBaseString(ByVal value As String, ByVal fromBase As Integer, ByVal toBase As Integer) As String
        Try
            If value.Trim = "" Then Return ""
            value = value.Replace(Chr(32), "")
            value = value.Replace(vbCrLf, "")
            value = value.Replace(vbCr, "")
            value = value.Replace(vbLf, "")
            Dim intValue As Integer = Convert.ToInt32(value, fromBase)
            Return Convert.ToString(intValue, toBase)
        Catch ex As Exception
            Return "错误"
        End Try
    End Function


    ''' <summary>
    ''' 给字符串加密(不可逆)
    ''' </summary>
    ''' <param name="sourString">源加密字符串</param>
    ''' <param name="sKey">加密密钥</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetCodeString(ByVal sourString As String, ByVal sKey As String) As String
        If sKey.Trim = "" Then Return sourString
        If sourString.Trim = "" Then Return ""
        Dim keyCode As String = "", keyCodes As New StringBuilder
        Dim sL As Integer = sourString.Length
        Dim si As Integer = 0
        Dim strSI As String, ascSI As Integer, ascSIO As Long
        Dim ascSour As Long = GetStringASCS(sourString)
        Dim ascKey As Long = GetStringASCS(sKey)
        For si = 0 To sourString.Length - 1
            strSI = sourString.Substring(si, 1)
            ascSI = Asc(strSI)
            ascSIO = ascSI Xor (ascKey + si * 2)
            keyCode = ConvertBaseString(ascSIO.ToString, 10, 16)
            keyCodes.Append(keyCode)
        Next
        Return keyCodes.ToString.ToUpper
    End Function

    ''' <summary>
    ''' 获取字符串ASCII码
    ''' </summary>
    ''' <param name="sString">要处理的字符串</param>
    ''' <param name="canBack">是否支持可逆处理 True:可逆 False:不可逆</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetStringASCS(ByVal sString As String, Optional canBack As Boolean = False) As Long
        Dim strI As String, ascI As Integer, ascAll As Long
        For i As Integer = 0 To sString.Length - 1
            strI = sString.Substring(i, 1)
            ascI = Asc(strI)
            ascAll += ascI
        Next
        If canBack Then
            Return ascAll * 5 + 65
        Else
            Return ascAll + sString.Length * 2
        End If
    End Function

    ''' <summary>
    ''' 获取反字符串
    ''' </summary>
    ''' <param name="sString">要处理的字符串</param>
    ''' <param name="ChangeRL">是否左右对调</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetStringF(ByVal sString As String, Optional ByVal ChangeRL As Boolean = False) As String
        If sString.Trim = "" Then Return ""
        Dim tString As New StringBuilder, tStringRL As String = ""
        Dim strI As String, strNI As String = ""
        For i As Integer = 0 To sString.Length - 1
            strI = sString.Substring(i, 1)
            Select Case strI
                Case "0" To "9"
                    strNI = Chr(105 - Asc(strI))
                Case "A" To "Z"
                    strNI = Chr(155 - Asc(strI))
                Case "a" To "z"
                    strNI = Chr(219 - Asc(strI))
                Case Else

            End Select
            tString.Append(strNI)
        Next
        If ChangeRL Then
            tStringRL = StringChangeRL(tString.ToString)
            Return tStringRL
        Else
            Return tString.ToString
        End If

    End Function

    ''' <summary>
    ''' 字符串左右反转
    ''' </summary>
    ''' <param name="sString">要处理的字符串</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function StringChangeRL(ByVal sString As String) As String
        If sString.Trim = "" Then Return ""
        Dim tString As String = ""
        Dim strI As String
        For i As Integer = 0 To sString.Length - 1
            strI = sString.Substring(i, 1)
            tString = strI & tString
        Next
        Return tString
    End Function

    ''' <summary>
    ''' 获取机器序列号
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function GetSerNum() As String
        Dim serNums As String = ""
        Dim pCodeF As String = GetStringF(My.Computer.Name, True)
        If pCodeF.Trim = "" Then Return ""
        Dim pL As Integer = pCodeF.Length
        Dim strI1, strI2, strI3, strI4 As String
        Dim ascI1, ascI2, ascI3, ascI4 As Integer
        Dim ascIA As Integer, strN As String
        For i As Integer = 0 To pL - 1 Step 4
            strI1 = pCodeF.Substring(i, 1)
            ascI1 = Asc(strI1)
            If i < pL - 3 Then
                strI2 = pCodeF.Substring(i + 1, 1)
                ascI2 = Asc(strI2)
                strI3 = pCodeF.Substring(i + 2, 1)
                ascI3 = Asc(strI3)
                strI4 = pCodeF.Substring(i + 3, 1)
                ascI4 = Asc(strI4)
                ascIA = ascI1 + ascI2 + ascI3 + ascI4
                strN = ConvertBaseString(ascIA.ToString, 10, 16)
            Else
                If i < pL - 2 Then
                    strI2 = pCodeF.Substring(i + 1, 1)
                    ascI2 = Asc(strI2)
                    strI3 = pCodeF.Substring(i + 2, 1)
                    ascI3 = Asc(strI3)
                    ascIA = ascI1 + ascI2 + ascI3
                    strN = ConvertBaseString(ascIA.ToString, 10, 16)
                ElseIf i < pL - 1 Then
                    strI2 = pCodeF.Substring(i + 1, 1)
                    ascI2 = Asc(strI2)
                    ascIA = ascI1 + ascI2
                    strN = ConvertBaseString(ascIA.ToString, 10, 16)
                Else
                    strN = ConvertBaseString(ascI1.ToString, 10, 16)
                End If
            End If
            serNums &= strN
        Next
        serNums = serNums.ToUpper
        Return serNums
    End Function

    ''' <summary>
    ''' 格式化显示字符
    ''' </summary>
    ''' <param name="sString">要处理的字符</param>
    ''' <param name="formatChar">格式化插入字符</param>
    ''' <param name="sLen">间隔长度</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function FormatString(ByVal sString As String, Optional ByVal formatChar As String = "-", Optional ByVal sLen As Integer = 4) As String
        If sString Is Nothing Then Return ""
        If sString.Trim = "" Then Return ""
        Dim sL As Integer = sString.Length
        Dim tString As New StringBuilder
        Dim seldL As Integer = 0
        For i As Integer = 0 To sL - 1 Step sLen
            If i < sL - 3 Then
                seldL = 4
            Else
                seldL = sL - i
            End If
            If i = 0 Then
                tString.Append(sString.Substring(i, seldL))
            Else
                tString.Append(formatChar & sString.Substring(i, seldL))
            End If

        Next
        Return tString.ToString
    End Function

    ''' <summary>
    ''' 加密字符串(可逆)
    ''' </summary>
    ''' <param name="sourString">要加密的字符串</param>
    ''' <param name="sKey">密钥字符串(解密需要此密钥)</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function EncodeAccString(ByVal sourString As String, ByVal sKey As String) As String
        If sKey.Trim = "" Then Return sourString
        If sourString.Trim = "" Then Return ""
        Dim keyCode As String = "", keyCodes As New StringBuilder
        Dim sL As Integer = sourString.Length
        Dim si As Integer = 0
        Dim strSI As String, ascSI As Integer, ascSIO As Long
        'Dim ascSour As Long = GetStringASCS(sourString, True)
        Dim ascKey As Long = GetStringASCS(sKey, True)
        For si = 0 To sourString.Length - 1
            strSI = sourString.Substring(si, 1)
            ascSI = Asc(strSI)
            ascSIO = ascSI + ascKey
            keyCode = ConvertBaseString(ascSIO.ToString, 10, 16)
            If si = 0 Then
                keyCodes.Append(keyCode)
            Else
                keyCodes.Append("." & keyCode)
            End If
        Next
        Return StringToHex(keyCodes.ToString)
    End Function

    ''' <summary>
    ''' 解密字符串
    ''' </summary>
    ''' <param name="codeString">加密的内容字符串</param>
    ''' <param name="sKey">密钥</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function DecodeAccString(codeString As String, sKey As String) As String
        If sKey.Trim = "" Then Return codeString
        If codeString.Trim = "" Then Return ""
        Dim ascKey As Long = GetStringASCS(sKey, True)
        codeString = HexToString(codeString)
        Dim hexContents() As String = codeString.Split(".")
        Dim strI As String, valI As Long, strContents As New StringBuilder
        For l As Integer = 0 To UBound(hexContents)
            valI = ConvertBaseString(hexContents(l), 16, 10)
            valI = valI - ascKey
            strI = Chr(valI)
            strContents.Append(strI)
        Next
        Return strContents.ToString
    End Function

#End Region


#Region "邮件发送"
    ''' <summary>
    ''' 邮件发送对象类型
    ''' </summary>
    ''' <remarks></remarks>
    Structure MailMsg
        ''' <summary>
        ''' 发送服务器名称(一般是smtp.xxx.com 具体请查询邮箱配制)
        ''' </summary>
        ''' <remarks></remarks>
        Dim SentHost As String
        ''' <summary>
        ''' 发送邮件的邮箱名
        ''' </summary>
        ''' <remarks></remarks>
        Dim SentFrom As String
        ''' <summary>
        ''' 发送邮件的邮箱密码
        ''' </summary>
        ''' <remarks></remarks>
        Dim SentPWD As String

        ''' <summary>
        ''' 发送目标邮箱地址,多个用逗号隔开
        ''' </summary>
        ''' <remarks></remarks>
        Dim SentTo As String
        ''' <summary>
        ''' 发送邮件的主题
        ''' </summary>
        ''' <remarks></remarks>
        Dim mailSubject As String
        ''' <summary>
        ''' 发送邮件的内容
        ''' </summary>
        ''' <remarks></remarks>
        Dim mailBody As String
        ''' <summary>
        ''' 发送内容是否支持HTML格式(True:支持HTML格式 False:纯文本模式)
        ''' </summary>
        ''' <remarks></remarks>
        Dim isHTML As Boolean

    End Structure

    ''' <summary>
    ''' 发送邮件
    ''' </summary>
    ''' <param name="sMailMsg">要发送的邮件对象类型</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function SentMail(sMailMsg As MailMsg) As String
        Try
            If IsDBNull(sMailMsg) Then
                Return "错误:邮件对象未实例化"
            End If
            With sMailMsg
                If .SentHost = "" Then
                    Return "错误:发送服务器名称为空"
                ElseIf .SentFrom = "" Then
                    Return "错误:发送邮件的邮箱名为空"
                ElseIf .SentPWD = "" Then
                    Return "错误:发送邮件的邮箱密码为空"
                ElseIf .SentTo = "" Then
                    Return "错误:发送目标邮箱地址为空"
                End If
            End With

            Dim mMessage As System.Net.Mail.MailMessage = New System.Net.Mail.MailMessage(sMailMsg.SentFrom, sMailMsg.SentTo, sMailMsg.mailSubject, sMailMsg.mailBody)
            mMessage.IsBodyHtml = sMailMsg.isHTML
            Dim mailClient As New System.Net.Mail.SmtpClient()
            '/VS2005下必须设置Credentials，而vs2008下不须设置
            Dim myCredentials As New Net.NetworkCredential(sMailMsg.SentFrom, sMailMsg.SentPWD)
            mailClient.Credentials = myCredentials
            mailClient.Host = sMailMsg.SentHost
            mailClient.Port = 25
            mailClient.Send(mMessage)
            Return "OK"
        Catch ex As Exception
            Return "发送失败:" & ex.Message
        End Try
    End Function

    ''' <summary>
    ''' 发送邮件
    ''' </summary>
    ''' <param name="sentHost">发送服务器名称(一般是smpt.xxx.com 具体请查询邮箱配制)</param>
    ''' <param name="sentFrom">发送邮件的邮箱名</param>
    ''' <param name="sentPWD">发送邮件的邮箱密码</param>
    ''' <param name="sentTo">发送目标邮箱地址,多个用逗号隔开</param>
    ''' <param name="mailSubject">发送邮件的主题</param>
    ''' <param name="mailBody">发送邮件的内容</param>
    '''  <param name="isHTML">发送内容是否支持HTML格式(True:支持HTML格式 False:纯文本模式)</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function SentMail(sentHost As String, sentFrom As String, sentPWD As String, sentTo As String, Optional mailSubject As String = "", Optional mailBody As String = "", Optional isHTML As Boolean = True) As String
        Dim sMMsg As New MailMsg
        With sMMsg
            .SentHost = sentHost
            .SentFrom = sentFrom
            .SentPWD = sentPWD
            .SentTo = sentTo
            .mailSubject = mailSubject
            .mailBody = mailBody
            .isHTML = isHTML
        End With
        Return SentMail(sMMsg)
    End Function

#End Region

#Region "数据库处理"


    Dim objSQL As New SQLDBClass

    ''' <summary>
    ''' SQL数据连接对象
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Property SQLConn As SQLDBClass
        Get
            Return objSQL
        End Get
        Set(value As SQLDBClass)
            objSQL = value
        End Set
    End Property

    ''' <summary>
    ''' 连接SQL数据库,连接成功返回True,失败返回False
    ''' </summary>
    ''' <param name="SQLServer">SQL服务器地址</param>
    ''' <param name="dbName">要打开的数据库名称</param>
    ''' <param name="uID">连接用户名</param>
    ''' <param name="PWD">连接密码</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function openDatabase(SQLServer As String, dbName As String, uID As String, PWD As String) As Boolean
        Try

            If objSQL.Status = Data.ConnectionState.Closed Then
                If objSQL.DataConnection(SQLServer, dbName, uID, PWD, False) Then
                    SQLConn = objSQL
                    Return True
                Else
                    Return False
                End If
            ElseIf objSQL.Status = Data.ConnectionState.Open Then
                Return True
            Else
                Return False
            End If

        Catch ex As Exception
            MsgBox("连接数据库出错:" & vbCrLf & ex.Message)
            Return False
        End Try
    End Function

#Region "读取数据表Datatable"

    ''' <summary>
    ''' 从存储过程查询数据表
    ''' </summary>
    ''' <param name="procedureName">存储过程名称</param>
    ''' <param name="sParameter">SQL转译参数列表</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataTableP(procedureName As String, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Data.DataTable
        Try
            Dim dtData As Data.DataTable = objSQL.ExecProduce(procedureName, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Return dtData
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function


    ''' <summary>
    ''' 通过完整SQL语句查询数据表
    ''' </summary>
    ''' <param name="SQLString">SQL语句</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataTableA(SQLString As String, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Data.DataTable
        Try
            Dim dtData As Data.DataTable = objSQL.OpenTable(SQLString, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Return dtData
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

    ''' <summary>
    ''' 从字段查询数据表(返回全部数据集)
    ''' </summary>
    ''' <param name="tableName">要查询的表名称</param>
    ''' <param name="fieldNames">要查询的字段，多个用逗号(,)隔开</param>
    ''' <param name="condString">查询条件</param>
    ''' <param name="orderBy">排序条件</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataTable(tableName As String, Optional fieldNames As String = "*", Optional condString As String = "", Optional orderBy As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Data.DataTable
        Dim Sqlstring As String = ""
        Try
            If condString.Trim <> "" Then
                If Not condString.ToLower.Contains("where") Then
                    condString = " where " & condString
                End If
            End If
            If orderBy.Trim <> "" Then
                orderBy = orderBy.Replace(Chr(32) & Chr(32), Chr(32))
                If Not orderBy.ToLower.Contains("order by") Then
                    orderBy = " order by " & orderBy
                End If
            End If
            Sqlstring = "select " & fieldNames & " from " & tableName & " " & condString & " " & orderBy
            Dim dtData As Data.DataTable = objSQL.OpenTable(Sqlstring, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Return dtData
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

    ''' <summary>
    ''' 从字段查询数据表(返回分页数据集)
    ''' </summary>
    ''' <param name="tableName">要查询的字段，多个用逗号(,)隔开</param>
    ''' <param name="fieldNames">要查询的表名称</param>
    ''' <param name="condString">查询条件</param>
    ''' <param name="orderBy">排序条件</param>
    ''' <param name="pageSize">每页显示记录数</param>
    ''' <param name="pageInd">当前页索引</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataTableN(tableName As String, Optional fieldNames As String = "*", Optional condString As String = "", Optional orderBy As String = "", Optional pageSize As Integer = 0, Optional pageInd As Integer = 1, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Data.DataTable
        Dim Sqlstring As String = ""
        Try
            'Dim Paramarry As String = "'" & tableName & "','" & fieldNames & "','" & condString & "','" & orderBy & "'," & pageSize & "," & pageInd
            If sParameter Is Nothing Then
                Dim sParameter1() As Data.SqlClient.SqlParameter = { _
                                      New Data.SqlClient.SqlParameter("@tableName", tableName) _
                                    , New Data.SqlClient.SqlParameter("@fieldName", fieldNames) _
                                    , New Data.SqlClient.SqlParameter("@condition", condString) _
                                    , New Data.SqlClient.SqlParameter("@orderBy", orderBy) _
                                    , New Data.SqlClient.SqlParameter("@pgSize", pageSize) _
                                    , New Data.SqlClient.SqlParameter("@curPage", pageInd) _
                                 }
                sParameter = sParameter1
            End If

            Dim dtData As Data.DataTable = GetDataTableP("SelectTable", sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Return dtData
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

    ''' <summary>
    ''' 从SQL语句查询数据表(返回分页数据集)
    ''' </summary>
    ''' <param name="SQLString">要查询的字段，多个用逗号(,)隔开</param>
    ''' <param name="orderBy">排序条件</param>
    ''' <param name="pageSize">每页显示记录数</param>
    ''' <param name="pageInd">当前页索引</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataTableN(SQLString As String, orderBy As String, pageSize As Integer, Optional pageInd As Integer = 1, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Data.DataTable
        Try
            If sParameter Is Nothing Then
                Dim sParameter1() As Data.SqlClient.SqlParameter = { _
                                      New Data.SqlClient.SqlParameter("@SQLString", SQLString) _
                                    , New Data.SqlClient.SqlParameter("@orderBy", orderBy) _
                                    , New Data.SqlClient.SqlParameter("@pgSize", pageSize) _
                                    , New Data.SqlClient.SqlParameter("@curPage", pageInd) _
                                 }
                sParameter = sParameter1
            End If

            Dim dtData As Data.DataTable = GetDataTableP("SelectTableA", sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Return dtData
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function
#End Region

#Region "读取数据表读取集DBReader"
    ''' <summary>
    ''' 从Datatable获取数据读取集
    ''' </summary>
    ''' <param name="dbTable">Datatable数据集</param>
    ''' <param name="fieldPrefix">字段前缀</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataReader(dbTable As Data.DataTable, Optional fieldPrefix As String = "") As DBReaders
        Dim dbRead As New DBReaders(dbTable, fieldPrefix)
        Return dbRead
    End Function

    ''' <summary>
    ''' 从SQL语句查询数据表读取集(返回分页数据集)
    ''' </summary>
    ''' <param name="SQLString">要查询的字段，多个用逗号(,)隔开</param>
    ''' <param name="orderBy">排序条件</param>
    ''' <param name="pageSize">每页显示记录数</param>
    ''' <param name="pageInd">当前页索引</param>
    ''' <param name="fieldPrefix">字段前缀</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataReaderN(SQLString As String, orderBy As String, pageSize As Integer, Optional pageInd As Integer = 1, Optional fieldPrefix As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As DBReaders
        Try
            Dim dtData As Data.DataTable = GetDataTableN(SQLString, orderBy, pageSize, pageInd, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Dim dReader As DBReaders = New DBReaders(dtData, fieldPrefix)
            Return dReader
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

    ''' <summary>
    ''' 从字段查询数据表读取集(返回分页数据集)
    ''' </summary>
    ''' <param name="tableName">要查询的字段，多个用逗号(,)隔开</param>
    ''' <param name="fieldNames">要查询的表名称</param>
    ''' <param name="condString">查询条件</param>
    ''' <param name="orderBy">排序条件</param>
    ''' <param name="pageSize">每页显示记录数</param>
    ''' <param name="pageInd">当前页索引</param>
    ''' <param name="fieldPrefix">字段前缀</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataReaderN(tableName As String, Optional fieldNames As String = "*", Optional condString As String = "", Optional orderBy As String = "", Optional pageSize As Integer = 0, Optional pageInd As Integer = 1, Optional fieldPrefix As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As DBReaders
        Dim Sqlstring As String = ""
        Try
            Dim dtData As Data.DataTable = GetDataTableN(tableName, fieldNames, condString, orderBy, pageSize, pageInd, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Dim dReader As DBReaders = New DBReaders(dtData, fieldPrefix)
            Return dReader
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function


    ''' <summary>
    ''' 从字段查询数据表读取集(返回全部数据集)
    ''' </summary>
    ''' <param name="tableName">要查询的表名称</param>
    ''' <param name="fieldNames">要查询的字段，多个用逗号(,)隔开</param>
    ''' <param name="condString">查询条件</param>
    ''' <param name="orderBy">排序条件</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <param name="fieldPrefix">字段前缀</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataReader(tableName As String, Optional fieldNames As String = "*", Optional condString As String = "", Optional orderBy As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing, Optional fieldPrefix As String = "") As DBReaders
        Try
            Dim dtData As Data.DataTable = GetDataTable(tableName, fieldNames, condString, orderBy, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Dim dReader As DBReaders = New DBReaders(dtData, fieldPrefix)
            Return dReader
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

    ''' <summary>
    ''' 通过完整SQL语句查询数据表读取集
    ''' </summary>
    ''' <param name="SQLString">SQL语句</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <param name="fieldPrefix">字段前缀</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataReaderA(SQLString As String, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing, Optional fieldPrefix As String = "") As DBReaders
        Try
            Dim dtData As Data.DataTable = GetDataTableA(SQLString, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Dim dReader As DBReaders = New DBReaders(dtData, fieldPrefix)
            Return dReader
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

    ''' <summary>
    ''' 从存储过程查询数据表读取集
    ''' </summary>
    ''' <param name="procedureName">存储过程名称</param>
    ''' <param name="Paramarry">传入参数列表</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <param name="fieldPrefix">字段前缀</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetDataReaderP(procedureName As String, Optional Paramarry As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing, Optional fieldPrefix As String = "") As DBReaders
        Try

            Dim dtData As Data.DataTable = GetDataTableP(procedureName, sParameter)
            If dtData Is Nothing Then Return Nothing
            If dtData.Rows.Count < 1 Then Return Nothing
            Dim dReader As DBReaders = New DBReaders(dtData, fieldPrefix)
            Return dReader
        Catch ex As Exception
            MsgBox("数据查询出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

#End Region

#Region "数据添删改操作"

    ''' <summary>
    ''' 调用储过程不返回数据(用于添删改等)
    ''' </summary>
    ''' <param name="produceName">存储过程名称</param>
    ''' <param name="parame">存储过程参数</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function ExecuteProdN(ByVal produceName As String, Optional parame As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Boolean
        Try
            Dim Sqlstring As String
            Sqlstring = "execute " & produceName & " " & parame
            Return ExecuteSQL(Sqlstring, sParameter)
        Catch ex As Exception
            'MsgBox("执行存储过程出错:" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly, "出错了")
            Return Nothing
        End Try
    End Function

    ''' <summary>
    ''' 执行SQL(用于Insert 或 Update)，成功返回True，不成功返回False
    ''' </summary>
    ''' <param name="SQLString">SQL语句</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function ExecuteSQL(ByVal SQLString As String, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Boolean
        Try
            Return objSQL.DataCommand(SQLString, sParameter)
        Catch ex As Exception
            Return False
        End Try
    End Function

    ''' <summary>
    ''' 执行SQL(用于Insert,成功返回ID值，不成功返回0)
    ''' </summary>
    ''' <param name="SQLString">SQL语句</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function InsertData(ByVal SQLString As String, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Integer
        Try
            Return objSQL.DataCommandA(SQLString, sParameter)
        Catch ex As Exception
            Return 0
        End Try
    End Function

    ''' <summary>
    ''' 删除记录
    ''' </summary>
    ''' <param name="tableName">表名称</param>
    ''' <param name="did">记录ID</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function delRecordA(tableName As String, did As String, Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Boolean
        Dim cond As String = " where id=" & did
        If did.Contains(",") Then
            cond = " where id in(" & did & ")"
        End If
        Dim sqlD As String = "delete   from " & tableName & cond
        If ExecuteSQL(sqlD, sParameter) Then
            Return True
        Else
            Return False
        End If
    End Function

    ''' <summary>
    ''' 检测记录是否存在
    ''' </summary>
    ''' <param name="tableName">表名</param>
    ''' <param name="fieldNames">字段名</param>
    ''' <param name="condString">条件</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function checkExist(tableName As String, fieldNames As String, Optional chkValue As String = "", Optional condString As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Boolean
        If chkValue <> "" Then
            If condString <> "" Then
                condString &= " and " & fieldNames & "=" & chkValue
            Else
                condString = fieldNames & "=" & chkValue
            End If

        End If
        Dim dtChk As Data.DataTable = GetDataTable(tableName, fieldNames, condString, "", sParameter)
        If dtChk IsNot Nothing Then
            Dim r As Integer = dtChk.Rows.Count
            If r > 0 Then
                Return True
            Else
                Return False
            End If
        Else
            Return False
        End If
    End Function


#End Region

    ''' <summary>
    ''' 获取记录数
    ''' </summary>
    ''' <param name="tableName">数据表名</param>
    ''' <param name="condString">查询条件</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getRecordCount(tableName As String, Optional condString As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As Integer
        Dim recCount As Integer = 0
        Dim Paramarry As String = "'" & tableName & "',' count(*) as rCount','" & condString & "'"
        If sParameter Is Nothing Then
            Dim sParameter1() As Data.SqlClient.SqlParameter = {New Data.SqlClient.SqlParameter("@tableName", tableName) _
                     , New Data.SqlClient.SqlParameter("@fieldName", " count(*) as rCount") _
                     , New Data.SqlClient.SqlParameter("@condition", condString) _
                     , New Data.SqlClient.SqlParameter("@orderBy", "") _
                     , New Data.SqlClient.SqlParameter("@pgSize", 0) _
                     , New Data.SqlClient.SqlParameter("@curPage", 1) _
                  }
            sParameter = sParameter1
        End If
        Dim dtCount As Data.DataTable = GetDataTableP("SelectTable", sParameter)
        If dtCount Is Nothing Then
            recCount = 0
        Else
            recCount = dtCount.Rows(0)("rCount")
        End If
        Return recCount
    End Function

    ''' <summary>
    ''' 获取字段信息
    ''' </summary>
    ''' <param name="fieldName">要查询的字段名称</param>
    ''' <param name="tableName">要查询的表名称</param>
    ''' <param name="condString">查询条件</param>
    ''' <param name="sParameter">SQL转译参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getFiledvalue(ByVal fieldName As String, ByVal tableName As String, Optional condString As String = "", Optional sParameter() As Data.SqlClient.SqlParameter = Nothing) As String
        Try
            Dim dtFie As Data.DataTable = GetDataTable(tableName, fieldName, condString, "", sParameter)
            If dtFie IsNot Nothing Then
                ' Return dtFie.Rows(0)(fieldName).ToString
                Return dtFie.Rows(0)(0).ToString
            Else
                Return ""
            End If
        Catch ex As Exception
            Return ""
        End Try
    End Function

    ''' <summary>
    ''' 从列表数组中匹配数据
    ''' </summary>
    ''' <param name="arr">列表数组</param>
    ''' <param name="val">匹配数据</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function getValueFromArr(ByVal arr() As String, ByVal val As String) As String
        Dim s As String, vi As String = ""
        For i As Integer = 0 To UBound(arr)
            vi = arr(i).Trim
            If vi.Contains(val) Then
                s = arr(i)
                Return s
            End If
        Next
        Return ""
    End Function

    ''' <summary>
    ''' 数组转换成字符串
    ''' </summary>
    ''' <param name="arr">要转换的数组对象</param>
    ''' <param name="joinChar">连接字符( 默认回车)</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function ArrToString(arr() As String, Optional joinChar As String = vbCrLf) As String
        Dim strV As New StringBuilder
        Dim c As Integer = UBound(arr)
        For i As Integer = 0 To c
            If i < c Then
                strV.Append(arr(i) & joinChar)
            Else
                strV.Append(arr(i))
            End If

        Next
        Return strV.ToString
    End Function

    ''' <summary>
    ''' 显示DataTable数据信息
    ''' </summary>
    ''' <param name="sdataTable">DataTable数据对象</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function showDataTable(ByVal sdataTable As Data.DataTable) As String
        Dim strData As String = ""
        Dim tbHead As String = "<table  width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""2"" class=""border_a1"">"
        Dim tbEnd As String = "</table>"
        Dim trData As String = ""
        If sdataTable Is Nothing Then Return ""
        Dim row As Integer = sdataTable.Rows.Count
        Dim col As Integer = sdataTable.Columns.Count
        If col = 0 Then Return ""
        tbHead = tbHead & "<tr>"
        For c As Integer = 0 To col - 1
            tbHead &= "<td  align=center bgcolor=#D8E1FE>" & sdataTable.Columns(c).ColumnName & "</td>"
        Next
        tbHead &= "</tr>"
        If row > 0 Then
            For r As Integer = 0 To row - 1
                trData &= "<tr>"
                For c As Integer = 0 To col - 1
                    trData &= "<td  align=center>" & sdataTable.Rows(r)(c).ToString & "</td>"
                Next
                trData &= "</tr>"
            Next
        End If
        strData = tbHead & trData & tbEnd
        Return strData
    End Function

#End Region

End Module

